(define (make-leaf symbol weight)
    (list `leaf symbol weight)
)
(define (leaf? object)
    (eq? (car object) `leaf)
)
(define (symbol-leaf x) (cadr x))
(define (weight-leaf x) (caddr x))

(define (make-code-tree left right)    
    (list 
        left
        right
        (append 
            (symbols left)
            (symbols right)
        )
        (+ (weight left) (weight right))
    )
)

(define (left-branch tree) (car tree))
(define (right-branch tree) (cadr tree))
(define (symbols tree)
    (if (leaf? tree)
        (list (symbol-leaf tree))
        (caddr tree)
    )
)
(define (weight tree)
    (if (leaf? tree)
        (weight-leaf tree)
        (cadddr tree)
    )
)

(define (adjoin-set x set)
    (cond 
        ((null? set) (list x))
        (< (cadr x) (cadr (car set))
            (cons x set)
        )
        (else 
            (cons 
                (car set)
                (adjoin-set x (cdr set))
            )
        )
    )
)
(define (make-leaf-set pairs)
    (if (null? pairs)
        `()
        (let 
            (
                (pair (car pairs))
            )
            (adjoin-set 
                (make-leaf 
                    (car pair)
                    (cadr pair)
                )
                (make-leaf-set (cdr pairs))
            )
        )
    )
)



(define (generate-huffman-tree pairs)
    (successive-merge (make-leaf-set pairs))
)

(define (successive-merge set)
    (if (null? (cdr set))
        (car set) 
        (successive-merge
            (adjoin-set 
                (make-code-tree
                    (car set)
                    (cadr set) 
                )
                (cddr set)
            )
        )
    )
)
(define (encode message tree)
    (if (null? message)
        `()
        (append 
            (encode-symbol (car message) tree)
            (encode (cdr message) tree)
        )
    )
)

(define (encode-symbol my-symbol tree)
    (if (leaf? tree)
        `()
        (if (has-symbol? my-symbol (symbols (left-branch tree)))
            (append 
                (list `0)
                (encode-symbol my-symbol (left-branch tree))
            )
            (append
                (list `1)
                (encode-symbol my-symbol (right-branch tree))
            )
        )
    )
)

(define (has-symbol? my-symbol list-item)
    (cond 
        ((null? list-item) #f)
        ((eq? my-symbol (car list-item)) #t)
        (else (has-symbol? my-symbol (cdr list-item)))
    )
)

(define test-pairs 
    (list  
        (list `BOOM 1) 
        (list `WAH 1) 
        (list `A 2) 
        (list `GET 2) 
        (list `JOB 2)
        (list `SHA 3)
        (list `YIP 9)
        (list `NA 16) 
    )
)

(define test-tree (generate-huffman-tree test-pairs))
(define test-message `(GET A JOB SHA NA NA NA NA NA NA NA NA GET A JOB SHA NA NA NA NA NA NA NA NA WAH YIP YIP YIP YIP YIP YIP YIP YIP YIP SHA BOOM))

(display (length (encode test-message test-tree)))
(exit)